#! /usr/bin/runghc

import Prelude hiding(flip)
import Data.Char
import Data.Maybe (fromJust)
import Foreign
import Foreign.C
import Foreign.Ptr
import Graphics.UI.SDL
import Graphics.UI.SDL.Image
import System.IO.MMap
-- import Text.Printf (printf)

import qualified Retro8 as R8


handleEvents :: Event -> IO ()
handleEvents Quit = return ()
handleEvents (KeyDown (Keysym SDLK_RETURN _ _)) = return ()
-- handleEvents (KeyDown (Keysym SDLK_DOWN _ _)) = return ()
handleEvents _ = waitEvent >>= handleEvents

pokeLine :: R8.TiledScreen -> Int -> IO ()
-- pokeLine s y = mapM_ (\x -> pokeScreen s x y 0x5a) [0..69]
pokeLine s y = f 69
  where f 0 = return ()
        f x = R8.pokeScreen s x y 0x5a >> f (x-1)
        
mainF scr charset screen = do
  R8.fillScreen screen 0x66
  mapM_ (\(x,y) -> R8.pokeScreen screen x y 0x53) [(x,y) | x<-[1..68], y<-[1..40]]
  mapM_ (pokeLine screen) [42..48]
  print =<< R8.blitScreenXY screen scr 3 2
  flip scr
  delay 2000
  R8.scrollScreenUp screen
  withForeignPtr screen $ \s -> f_print_tests s
  _ <- R8.blitScreenXY screen scr 3 2
  flip scr
  handleEvents NoEvent

writePtr :: Surface -> Ptr a -> IO ()
writePtr s p = withForeignPtr s $ \s' -> poke p' s'
  where p' :: Ptr (Ptr SurfaceStruct)
        p' = castPtr $ plusPtr p 0x20

writeMMStr :: String -> Ptr a -> IO ()
writeMMStr s p = pokeArray p' $ map (fromIntegral . ord) s
  where p' :: Ptr Word8
        p' = castPtr p

-- void f_retro1(void *mmap);
foreign import ccall unsafe "f_retro1" retroFun1 :: Ptr a -> IO ()
-- void f_retro2(SDL_Surface *surfs[]);
foreign import ccall unsafe "f_retro2" retroFun2 :: Ptr (Ptr SurfaceStruct) -> IO ()
-- void f_changeSurfaceColour(SDL_Surface *s)
foreign import ccall unsafe "f_changeSurfaceColour" f_changeSurfaceColour :: Ptr SurfaceStruct -> IO ()
-- void f_print_tests(R8B_Tiled_Screen *scr);
foreign import ccall unsafe "f_print_tests" f_print_tests :: Ptr R8.TiledScreenStruct -> IO ()



main = withInit [InitEverything] $ do
  scr <- setVideoMode 640 480 32 []
  -- charset <- displayFormat =<< load "charset64.png"
  charset <- load "charset64.png"
  charset' <- load "charset64.png"
  -- withForeignPtr charset f_changeSurfaceColour -- Now a nice green
  _ <- setColors charset [Color 0x8b 0x3f 0x96, Color 0xff 0xff 0xb2] 0
  screen <- fromJust `fmap` R8.createTiledScreenUsingSurface 70 50 0x20 charset 8 8
  writeFile "/tmp/MMAP.retro8Test\xDE\xAD\xBE\xEF" $ replicate 65536 '\0'
  (mm,_,_,_) <- mmapFilePtr "/tmp/MMAP.retro8Test\xDE\xAD\xBE\xEF" ReadWrite Nothing
  writePtr charset mm
  writeMMStr "CHARSET" mm
  -- retroFun1 mm
  -- withArray0 nullPtr (map unsafeForeignPtrToPtr [scr, charset, charset']) retroFun2 
  print scr
  print charset
  print screen
  mainF scr charset screen
  -- the following line is necessary as the GC cleans up charset
  -- otherwise. WHILE WE ARE STILL USING IT!
  freeSurface charset
    
